home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / utils / ted / tedtro9.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-10-02  |  6.7 KB  |  247 lines
  1. {
  2.                           Coding & Editing by :
  3.         █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀█ █ █▀▀▀▀▀▀▀ █▀▀▀▀▀▀▀
  4.         █▀▀▀▀▀▀▀ █▀▀▀▀▀▀█ █▀▀▀▀▀█▀ █▀▀▀▀▀▀█ █     █ █ ▀▀▀▀▀▀▀█ █▀▀▀▀▀
  5.         █        █      █ █      █ █      █ █     █ █        █ █
  6.         █        █      █ █      █ █      █ █     █ █        █ █
  7.         █        █      █ █      █ █      █ █     █ █        █ █
  8.         █        █      █ █      █ █      █ █▄▄▄▄▄█ █ ▄▄▄▄▄▄▄█ █▄▄▄▄▄▄▄
  9.  
  10.         Programmed by Marcin Jaskowiak, aka Paradise, Lublin, Poland,
  11.                           in Turbo Pascal 7.0.
  12.  
  13.         This is FUQNWARE - if u like it, u must register it by sending
  14.         some money (u tell how much) to ME:) if not - u choose.
  15.         Read TED.DOC 4 more info.
  16.  
  17.         Snail mail:                      Email:
  18.         Marcin Jaskowiak                 liksay@bachus.umcs.lublin.pl
  19.         Flat 114, 3 Zarnowiecka Str.
  20.         20-630 Lublin
  21.         Poland
  22.  
  23.                                Presents :
  24.                     TED font editor SCROLLERS PACK 94
  25.                                 with :
  26.                              EXAMPLE NR 9
  27. }
  28. PROGRAM TED_INTRO_NR9;
  29. USES DOS,CRT;
  30.  
  31. CONST
  32.  SEGA000        : WORD = $A000;
  33.  SCR_OFS        : WORD = 22400;
  34. VAR
  35.  BITMAP         : ARRAY [1..60,0..319] OF BYTE;
  36.  PALETTE        : ARRAY [0..255,1..3] OF BYTE;
  37.  CHARS          : ARRAY [' '..']'] OF POINTER;
  38.  CHARSDATA      : ARRAY [' '..']',1..3] OF BYTE;
  39.  F              : FILE;
  40.  B,ROW,NR       : BYTE;
  41.  X,Y,I          : INTEGER;
  42.  CH,K           : CHAR;
  43.  TEKST          : STRING;
  44.  PAL            : ARRAY [0..33] OF BYTE;
  45.  SINUS          : ARRAY [0..255] OF BYTE;
  46.  SINN           : BYTE;
  47.  YPOS,YINC      : INTEGER;
  48.  
  49. {───────────────────────────────────────────────────────────────────────────}
  50. PROCEDURE CALCSIN;
  51. VAR I : INTEGER;
  52. BEGIN
  53.  FOR I := 0 TO 255 DO SINUS[I] := ROUND(SIN(6*I*PI/555)*10)+11;
  54. END;
  55. {───────────────────────────────────────────────────────────────────────────}
  56. PROCEDURE INITVGA; ASSEMBLER; { INITIALIZE VGA CARD MODE 13H }
  57. ASM
  58.  MOV AX,0013H
  59.  INT 10H
  60. END;
  61. {───────────────────────────────────────────────────────────────────────────}
  62. PROCEDURE CLOSEVGA; ASSEMBLER; { CLOSE VGA MODE AND SET TEXT }
  63. ASM
  64.  MOV AX,0003H
  65.  INT 10H
  66. END;
  67. {───────────────────────────────────────────────────────────────────────────}
  68. PROCEDURE VSYNC; ASSEMBLER;
  69. ASM
  70.  MOV DX,03DAH
  71.  @L1: IN AL,DX; TEST AL,8; JNZ @L1;
  72.  @L2: IN AL,DX; TEST AL,8; JZ  @L2;
  73. END;
  74. {───────────────────────────────────────────────────────────────────────────}
  75. PROCEDURE DRAWBITMAP; ASSEMBLER;
  76. ASM
  77.  MOV DI,SCR_OFS
  78.  MOV ES,SEGA000
  79.  MOV SI,OFFSET BITMAP
  80.  MOV CX,9600
  81.  CLD
  82.  REP MOVSW
  83. END;
  84. {───────────────────────────────────────────────────────────────────────────}
  85. PROCEDURE SCROLLBITMAP(VAR MAP); ASSEMBLER;
  86. ASM
  87.   LDS SI,MAP
  88.   LES DI,MAP
  89.   INC SI
  90.   INC SI
  91.   INC SI
  92.   MOV CX,9600
  93.   REP MOVSW
  94. END;
  95. {───────────────────────────────────────────────────────────────────────────}
  96. PROCEDURE SETCOLOR(NR,R,G,B: BYTE); ASSEMBLER; { SET RGB VAL TO COLOR NR }
  97. ASM
  98.  MOV DX,3C8H
  99.  MOV AL,NR
  100.  OUT DX,AL
  101.  INC DX
  102.  MOV AL,R
  103.  OUT DX,AL
  104.  MOV AL,G
  105.  OUT DX,AL
  106.  MOV AL,B
  107.  OUT DX,AL
  108. END;
  109. {───────────────────────────────────────────────────────────────────────────}
  110. PROCEDURE LOADPAL(NAME: STRING); { LOAD .PAL FILE AND SET PALETTE }
  111. BEGIN
  112.  ASSIGN(F,NAME+'.PAL');
  113.  RESET(F,1);
  114.  BLOCKREAD(F,PALETTE,768);
  115.  CLOSE(F);
  116.  FOR B:=0 TO 255 DO SETCOLOR(B,PALETTE[B,1],PALETTE[B,2],PALETTE[B,3]);
  117. END;
  118. {───────────────────────────────────────────────────────────────────────────}
  119. PROCEDURE LOADTED(NAME: STRING); { LOAD .TED FILE TO MEMORY }
  120. VAR TX,TY: BYTE; CH: CHAR;
  121. BEGIN
  122.  ASSIGN(F,NAME+'.TED');
  123.  RESET(F,1);
  124.  SEEK(F,20);
  125.  WHILE NOT(EOF(F)) DO
  126.  BEGIN
  127.   BLOCKREAD(F,CH,1);
  128.   BLOCKREAD(F,TX,1);
  129.   BLOCKREAD(F,TY,1);
  130.   GETMEM(CHARS[CH],TX*TY);
  131.   CHARSDATA[CH,1]:=TX; CHARSDATA[CH,2]:=TY; CHARSDATA[CH,3]:=1;
  132.   BLOCKREAD(F,CHARS[CH]^,TX*TY);
  133.  END;
  134.  IF CHARSDATA[' ',3]<>1 THEN { IF NOT SPACE " " THEN CREATE IT }
  135.  BEGIN
  136.   TX:=CHARSDATA['A',1];
  137.   TY:=CHARSDATA['A',2];
  138.   GETMEM(CHARS[' '],TX*TY);
  139.   FILLCHAR(CHARS[' ']^,TX*TY,0);
  140.   CHARSDATA[' ',3]:=1;
  141.   CHARSDATA[' ',1]:=TX;
  142.   CHARSDATA[' ',2]:=TY;
  143.  END;
  144.  CLOSE(F);
  145. END;
  146. {───────────────────────────────────────────────────────────────────────────}
  147. PROCEDURE DONETED; { DEALLOCATE FONT MEMORY }
  148. VAR CH: CHAR;
  149. BEGIN
  150.  FOR CH:=' ' TO ']' DO
  151.  BEGIN
  152.   IF CHARSDATA[CH,3]=1 THEN
  153.   BEGIN
  154.    FREEMEM(CHARS[CH],CHARSDATA[CH,1]*CHARSDATA[CH,2]);
  155.    CHARSDATA[CH,3]:=0;
  156.   END;
  157.  END;
  158. END;
  159. {───────────────────────────────────────────────────────────────────────────}
  160. PROCEDURE NEWROW(CH: CHAR; RO: BYTE; POS: INTEGER); { DRAW HORIZ LINE }
  161. VAR II,TX,TY: INTEGER;
  162. BEGIN
  163.  FOR II:=1 TO 60 DO BITMAP[I,POS]:=210;
  164.  IF CHARSDATA[CH,3]<>1 THEN EXIT;
  165.  IF RO=CHARSDATA[CH,1]+1 THEN
  166.  FOR TY:=1 TO 34 DO BITMAP[TY,POS]:=200+TY-1
  167.  ELSE
  168.  FOR TY:=1 TO CHARSDATA[CH,2] DO
  169.   BITMAP[TY,POS]:=MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(TY-1)*CHARSDATA[CH,1]+RO-1];
  170. END;
  171. {───────────────────────────────────────────────────────────────────────────}
  172. PROCEDURE UPDATE; { NEW VALUES ? }
  173. BEGIN
  174.  INC(ROW);
  175.  IF ROW>CHARSDATA[TEKST[NR],1]+1 THEN
  176.  BEGIN
  177.   ROW:=1;
  178.   INC(NR);
  179.   IF NR>LENGTH(TEKST) THEN NR:=1;
  180.  END;
  181. END;
  182. {───────────────────────────────────────────────────────────────────────────}
  183. PROCEDURE MUTEFONT;
  184. VAR AX,AY: INTEGER; CH: CHAR;
  185. BEGIN
  186.  FOR CH:=' ' TO ']' DO
  187.  IF CHARSDATA[CH,3]=1 THEN
  188.  BEGIN
  189.   FOR AY:=0 TO CHARSDATA[CH,2]-1 DO
  190.   FOR AX:=0 TO CHARSDATA[CH,1]-1 DO
  191.   BEGIN
  192.    IF MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+AY*CHARSDATA[CH,1]+AX]=0 THEN
  193.    MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+AY*CHARSDATA[CH,1]+AX]:=200+AY;
  194.   END;
  195.  END;
  196. END;
  197. {───────────────────────────────────────────────────────────────────────────}
  198. PROCEDURE SETFPAL;
  199. VAR B: BYTE;
  200. BEGIN
  201.  FOR B:=0 TO 33 DO SETCOLOR(200+B,PAL[B],0,0);
  202. END;
  203. {───────────────────────────────────────────────────────────────────────────}
  204. PROCEDURE BAR(OFF: BYTE);
  205. BEGIN
  206.  FILLCHAR(PAL,34,0);
  207.  FOR I:=0 TO 5 DO
  208.  BEGIN
  209.   PAL[OFF+I]:=10+I*9;
  210.   PAL[OFF+11-I]:=10+I*9;
  211.  END;
  212.  SETFPAL;
  213. END;
  214. {───────────────────────────────────────────────────────────────────────────}
  215.  
  216.  
  217.  
  218. BEGIN
  219.  CALCSIN;
  220.  INITVGA;
  221.  LOADPAL('FONT010');
  222.  LOADTED('FONT010');
  223.  MUTEFONT;
  224.  ROW:=1;
  225.  TEKST:='  OK.. NOW TIME TO SOME BACKGROUND EFFECT...  ONE SINUS FLYING BAR...  @@ HMMM.. NOTHING TO SAY .. :-]             ';
  226.  NR:=1;
  227.  YPOS:=0;
  228.  SINN:=0;
  229.  REPEAT
  230.   SCROLLBITMAP(BITMAP);
  231.   UPDATE;
  232.   NEWROW(TEKST[NR],ROW,317);
  233.   UPDATE;
  234.   NEWROW(TEKST[NR],ROW,318);
  235.   UPDATE;
  236.   NEWROW(TEKST[NR],ROW,319);
  237.   DRAWBITMAP;
  238.   VSYNC;
  239.   INC(SINN);
  240.   IF SINN=183 THEN SINN:=0;
  241.   YPOS:=SINUS[SINN];
  242.   BAR(YPOS);
  243.   SETFPAL;
  244.  UNTIL KEYPRESSED;
  245.  DONETED;
  246.  CLOSEVGA;
  247. END.